home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 49
/
Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso
/
-serious-
/
graphics
/
amicad
/
arexx
/
tirertraits.amicad
< prev
next >
Wrap
Text File
|
1999-12-06
|
4KB
|
208 lines
/* Décalage et alignement des extrémités d'un ensemble de lignes */
/* Version 1.00 13/01/99 */
/* Version 1.01 06/02/99, Ajout UNLOCK */
/* Version 1.02 16/03/99, modif macro LIGNE */
/* Version 1.03 22/09/99, correction bug si annulation GETPOINT (ajout UNLOCK) */
/* $VER: 1.03 (© R.Florac, 22/09/99) */
options results
signal on error
signal on syntax
'DEF LIGNE(P)=P&0X07FFF'
'DEF COLONNE(P)=P>>15'
'LOCK(-1):SELECT("Extrémité à déplacer?"+CHR(10)+"Gauche"+CHR(10)+"Haut"+CHR(10)+"Droite"+CHR(10)+"Bas")'
d=result
select
when d=1 then do
'GETPOINT("Cliquez sur la colonne de destination")'; p=result
if p<0 then do
'UNLOCK(-1)'
exit
end
'COLONNE('p')'; col=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_gauche(o,col,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
when d=2 then do
'GETPOINT("Cliquez sur la ligne de destination")'; p=result
if p<0 then do
'UNLOCK(-1)'
exit
end
'LIGNE('p')'; ligne=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_haut(o,ligne,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
when d=3 then do
'GETPOINT("Cliquez sur la colonne de destination")'; p=result
if p<0 then do
'UNLOCK(-1)'
exit
end
'COLONNE('p')'; col=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_droite(o,col,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
when d=4 then do
'GETPOINT("Cliquez sur la ligne de destination")'; p=result
if p<0 then do
'UNLOCK(-1)'
exit
end
'LIGNE('p')'; ligne=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_bas(o,ligne,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
otherwise nop
end
'UNLOCK(-1)'
exit
mode_ligne: procedure
parse arg o
mode=-1000
'TYPE('o')'
select
when result=2 then mode=1 /* fil */
when result=15 then mode=2 /* ligne double */
when result=9 then mode=3 /* bus */
when result=8 then mode=0 /* pointillés */
when result=21 then do /* ligne spéciale */
'PENWIDTH('o',-10000)'
mode=0-result
end
otherwise nop
end
return mode
minima: procedure
parse arg v1,v2
if v1<v2 then return v1
return v2
end
maxima: procedure
parse arg v1,v2
if v1>v2 then return v1
return v2
end
retracer_gauche: procedure
parse arg o,col,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
xg=minima(x0,x1)
if x0=x1 then x1=col
if xg=x0 then do
x2=x1; y2=y1;
end
else do
x2=x0; y2=y0; y0=y1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('col','y0','x2','y2')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
retracer_haut: procedure
parse arg o,ligne,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
yh=minima(y0,y1)
if y0=y1 then y1=ligne
if yh=y0 then do
y2=y1; x2=x1;
end
else do
y2=y0; x2=x0; x0=x1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
retracer_droite: procedure
parse arg o,col,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
xd=maxima(x0,x1)
if x0=x1 then x0=col
if xd=x1 then do
x2=x0; y2=y0; y0=y1
end
else do
x2=x1; y2=y1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('x2','y2','col','y0')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
retracer_bas: procedure
parse arg o,ligne,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
yb=maxima(y0,y1)
if y0=y1 then y1=ligne
if yb=y0 then do
y2=y1; x2=x1;
end
else do
y2=y0; x2=x0; x0=x1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK(-1)'
exit
error:
'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK(-1)'
exit